home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #216 (1993)(Rhein-Sieg-Soft)(Disk 1 of 2).zip / Franz PD Disk #216 (1993)(Rhein-Sieg-Soft)(Disk 1 of 2).adf / KKK / cas8 (.txt) < prev    next >
AmigaBASIC Source Code  |  1993-02-02  |  33KB  |  1,050 lines
  1. REM Kompaktkassettenkuvert.REL,Version 1.18a
  2. REM Lothar Berndt,4240 Emmerich 1, 3/1990
  3. Init:
  4. Version$="Kompaktkassettenkuvert.REL, Version 1.18a"
  5. DEFINT a-z:FOR i=1 TO 4:MENU i,0,0,"":NEXT i
  6. ON ERROR GOTO Fehler
  7. ON BREAK GOSUB ControlC:BREAK ON
  8. IF FRE(-1)>500000 THEN
  9.   SNr=1:SCREEN SNr,640,256,2,2:bs=1
  10.   ELSE
  11.   SNr=-1:bs=0
  12. END IF
  13.   WINDOW 3,,(0,227)-(631,242),16,SNr:WINDOW CLOSE 1
  14.   WNr=2:WINDOW WNr,Version$,(0,0)-(631,212),22,SNr:wpr&=WINDOW(7)
  15.   OPEN"Farbdaten" FOR INPUT AS 1
  16.   INPUT#1,Farbzahl:DIM Farbwert!(Farbzahl,3)
  17.   FOR i=0 TO Farbzahl:FOR J=1 TO 3
  18.   INPUT#1,Farbwert!(i,J):NEXT J
  19.   PALETTE i,Farbwert!(i,1),Farbwert!(i,2),Farbwert!(i,3):NEXT i:CLOSE 1
  20.   WINDOW OUTPUT 3:GOSUB Text1:WINDOW OUTPUT WNr
  21.   CLS:LOCATE 13,31:PRINT"LESE LIBRARIES EIN"
  22.   DECLARE FUNCTION Examine& LIBRARY
  23.   DECLARE FUNCTION ExNext& LIBRARY
  24.   DECLARE FUNCTION Lock& LIBRARY
  25.   DECLARE FUNCTION AllocRemember& LIBRARY
  26.   dos.lib
  27.   intuition.lib
  28.   CLS:LOCATE 13,31:PRINT"VORBEREITUNGEN"
  29.   anz=50 'Anzahl der Einträge im Verzeichnis
  30.   m=27   'Anzahl der Felder-1, bei Seite A 14, bei Seite B 14
  31.   n=500  'Anzahl der Datensätze
  32.   DIM SHARED DirName$(anz),DirSize&(anz),DirBlks&(anz)
  33.   DIM a$(5),b$(m),c$(2),f$(m),la(m),la1(2),mo$(10),ra$(7),tf$(3)
  34.   FOR i=0 TO m:la(i)=31:NEXT i:la1(0)=3:la1(1)=60:la1(2)=60
  35.   tf$(0)="Nr.:":tf$(1)="TA:":tf$(2)="NR:":tf$(3)="LÄN:":fuell$=".":AB$=""
  36.   loesch$="":dn$="":c$="":Suffix$=".KKK_REL":tst=0:Satzlaenge=1081
  37.   l=3:p=3:abbruch=3:x=0:y=0:f=0:r=0:ll=0:c=0:px=0:py=0:h=0:SatzNr=0
  38.   Dateigroesse&=0:xp=0:yp=0:counter=0:gespeichert=0:RelOffen=0
  39.   qo=0:i=0:bx=6:hy=8:pa1=0:an=0:ze=0:fa=0:z=0:Spalte=0:Fett=0:Doppel=0:dr=0
  40.   jj=4000:px1=0:py1=0:px2=0:py2=0:qa=0:erg&=0:tt=0:req=0:win=0
  41.   ra$(0)=""
  42.   ra$(1)="ANFANG"  
  43.   ra$(2)="ENDE"  
  44.   ra$(3)="Maximale Anzahl erreicht"
  45.   ra$(4)="Daten ausgeben "
  46.   ra$(5)="Kompaktkassetenkuvert-Bildschirm"+CHR$(0)
  47.   ra$(6)="Das geht nicht!"
  48.   ra$(7)="Sicher?"
  49.   mo$(0)="Datei öffnen oder einrichten"
  50.   mo$(1)="Datei einrichten, Dateinamen eingeben"
  51.   mo$(2)=""
  52.   mo$(3)="Datensatz eingeben "
  53.   mo$(4)="Datensatz ausgeben "
  54.   mo$(5)=""
  55.   mo$(6)=""
  56.   mo$(7)=""
  57.   mo$(8)="Datei öffnen"
  58.   mo$(9)="Datei von Diskette löschen"
  59.   mo$(10)="Beenden"
  60.   esc$=CHR$(27):af$=CHR$(34):InitPrinter$=esc$+"#1"
  61.   CondOn$=esc$+"[4w":CondOff$=esc$+"[3w"
  62.   NLQOn$=esc$+"[2"+af$+"z":NLQOff$=esc$+"[1"+af$+"z"
  63.   UndlnOn$=esc$+"[4m":UndlnOff$=esc$+"[24m":NoMargin$=esc$+"#3"
  64.   MENU 1,0,1,"Datei"
  65.   MENU 1,1,1,"Einrichten ":MENU 1,2,1,"Öffnen     "
  66.   MENU 1,3,0,"Schließen  ":MENU 1,4,1,"Löschen    "
  67.   MENU 1,5,1,"Verzeichnis":MENU 1,6,1,"Ende       "
  68.   MENU 2,0,0,"Datensatz"
  69.   MENU 2,1,1,"Eingeben ":MENU 2,2,1,"Farbe    "
  70.   MENU 3,0,0,"Info"
  71.   MENU 3,1,1,"Programm"
  72.   MENU 3,2,1,"Datei   ":MENU 3,3,1,"Format  "
  73.   MENU 3,4,1,"Druck   ":MENU 3,5,1,"Tasten  "
  74.   IF bs=1 THEN GOSUB ScnT
  75.   CLS:GOSUB Titel:SetTitle"Verzeichnis lesen"
  76.   Dir$="Daten":GOSUB GetDir:gespeichert=0:SortDir:SetTitle mo$(0)
  77.   ON MENU GOSUB Auswahl:MENU ON
  78. Wa1:
  79.   SLEEP
  80.   GOTO Wa1
  81. Auswahl:
  82. ON MENU(0) GOTO men1,men2,men3
  83. men1: ON MENU(1) GOTO Einrichten,Laden,Schliessen,DateiLoeschen,Verz,Ende               
  84. men2: ON MENU(1) GOTO Eingabe,Farbe
  85. men3: ON MENU(1) GOTO Prg,Datei,DFormat,Kdruck,Tas
  86. MenuesAus:
  87.   FOR i=1 TO 3:MENU i,0,0:NEXT i:MENU OFF:RETURN
  88. MenuesAn:
  89.   FOR i=1 TO 3:MENU i,0,1:NEXT i:MENU ON:RETURN
  90. Titel:
  91.   LOCATE 12,27 :PRINT"Kompaktkassetten-Kuvert"
  92.   LOCATE 14,28:PRINT" Lothar Berndt  1990"
  93.   LOCATE 16,32:PRINT RIGHT$(Version$,13)
  94. RETURN
  95. Text1:
  96.   LINE(12,0)-(104,10),2,bf:LINE(114,0)-(206,10),2,bf
  97.   LINE(215,0)-(259,10),2,bf:LINE(265,0)-(309,10),2,bf  
  98.   LINE(315,0)-(359,10),2,bf:LINE(365,0)-(409,10),2,bf    
  99.   LINE(418,0)-(510,10),2,bf:LINE(520,0)-(612,10),2,bf       
  100.   LINE(12,14)-(206,25),2,bf:LINE(215,14)-(409,25),2,bf
  101.   LINE(418,14)-(510,25),2,bf:LINE(520,14)-(612,25),2,bf
  102. Text4:
  103. COLOR 1,2:xyPTAB 35,8:PRINT"ÄNDERN";PTAB(137)"ANFANG";PTAB(226)"<<<";
  104. PRINT PTAB(283)"<";PTAB(335)">";PTAB(377)">>>";PTAB(450)"ENDE";
  105. PRINT PTAB(539)"LÖSCHEN"
  106.   LOCATE 3,5:PRINT"KUVERTNUMMER SUCHEN";PTAB(243)"EIN KUVERT DRUCKEN";
  107.   PRINT PTAB(432)"FETTDRUCK";PTAB(523)"DOPPELDRUCK";:COLOR 1,0
  108. RETURN
  109. 650 FOR i=1 TO jj:NEXT i:RETURN
  110. DateiNameEingabe:
  111.   wt$="Dateinamen eingeben: ":GOSUB OpenWin4
  112.   c$=STRING$(14,32):getline 2,3,14,c$,3,0
  113.   c$=LEFT$(c$,p-1):FOR f=LEN(c$) TO 13:c$=c$+fuell$:NEXT f
  114.   dn$="Daten/"+c$+Suffix$
  115.   WINDOW CLOSE 4:c$="":RETURN
  116. OpenWin4:
  117.   WINDOW 4,wt$,(218,100)-(406,150),0,SNr
  118.   LINE (14,5)-(130,18),,b :REM *** Rahmen um Cursor
  119.   LINE (14,28)-(80,42),2,bf:LINE (110,28)-(176,42),2,bf:COLOR 1,2
  120.   LOCATE 5,1:PRINT PTAB(38)"OK";PTAB(116)"ABBRUCH";:COLOR 1,0:RETURN
  121. Info:
  122.   WINDOW 5,"Info:",(218,100)-(406,150),0,SNr:RETURN
  123. Kopfzeile:
  124.   CLS
  125.   LOCATE 1,2:COLOR 2:PRINT"Kuvertnummer:":COLOR 1
  126.   LOCATE 1,23:COLOR 2:PRINT"Frei BASIC:";:COLOR 1:PRINT FRE(1)
  127.   LOCATE 1,44:COLOR 2:PRINT"Frei System:";:COLOR 1:PRINT FRE(-1)
  128.   LOCATE 3,2:COLOR 2:PRINT"Datens. belegt:";:COLOR 1:PRINT an:COLOR 2
  129.   LOCATE 3,23:PRINT"Datens. frei:";:COLOR 1:PRINT n-an:COLOR 2
  130.   LOCATE 3,44:PRINT"Dateiname: ";:COLOR 1:PRINT LEFT$(dn$,20)
  131.   LOCATE 5,8:PRINT"Nr.:":LOCATE 5,25:PRINT"TA:"
  132.   LOCATE 5,41:PRINT"NR:":LOCATE 5,58:PRINT"LÄN:"
  133.   LOCATE 6,8:PRINT"A:":LOCATE 6,41:PRINT"B:"
  134.   RETURN
  135. Loeschen:
  136.   LOCATE 1,16:PRINT"   "
  137.   LOCATE 5,12:PRINT SPACE$(8):LOCATE 5,28:PRINT SPACE$(8)
  138.   LOCATE 5,44:PRINT SPACE$(8):LOCATE 5,62:PRINT SPACE$(8)
  139.   LOCATE 6,10:PRINT SPACE$(29):LOCATE 6,43:PRINT SPACE$(29) 
  140.   LINE(51,54)-(310,168),0,bf:LINE(316,54)-(573,168),0,bf
  141.   FOR ll=0 TO 2:LOCATE 23+ll,12:PRINT SPACE$(la1(ll)):NEXT ll
  142.   RETURN
  143. Rahmen:  
  144.   LINE (48,25)-(576,205),1,b:LINE (48,52)-(576,52),1
  145.   LINE (48,170)-(576,170),1:LINE (313,52)-(313,170),1
  146. RETURN
  147. NrAB:
  148.   LOCATE 23,8:PRINT"Nr:":LOCATE 24,8:PRINT" A:":LOCATE 25,8:PRINT" B:"
  149. RETURN
  150. GetDir:
  151.   counter=1:Dir$=Dir$+CHR$(0):Lo&=Lock&(SADD(Dir$),-2) 
  152.   IF Lo&=0 THEN ERROR 75
  153.   Info&=AllocRemember&(0,252,65538)
  154.   IF Info&=0 THEN CALL UnLock&(Lo&):ERROR 76
  155.   suc&=Examine&(Lo&,Info&)
  156.   IF suc&=0 THEN GOSUB Fin:ERROR 77
  157.   again:
  158.   DirName&=Info&+8
  159.   FOR search=0 TO 29
  160.     check=PEEK(DirName&+search)
  161.     IF check<>0 THEN check$=check$+CHR$(check) :ELSE search=29
  162.   NEXT search
  163.   IF RIGHT$(check$,8)=Suffix$ THEN
  164.     DirName$(counter)=check$:check$=""
  165.     DirSize&(counter)=PEEKL(Info&+124)
  166.     DirBlks&(counter)=PEEKL(Info&+128)
  167.     counter=counter+1
  168.      ELSE
  169.     check$="" 
  170.   END IF
  171.   suc&=ExNext&(Lo&,Info&)
  172.   IF suc&=0 THEN
  173.     GOTO Fin
  174.     ELSE
  175.     IF counter<=anz THEN again
  176.   END IF
  177.   Fin: CALL FreeRemember&(0,-1):CALL UnLock&(Lo&)
  178. RETURN
  179. ScnT: st&=SADD(ra$(5)):CALL SetWindowTitles&(wpr&,-1,st&):RETURN
  180. DNam: LOCATE 2,20:PRINT "Dateiname: ";LEFT$(dn$,20):RETURN
  181. st: SetTitle mo$(0):RETURN
  182. '----------
  183. Einrichten:
  184. '----------
  185.   MENU 1,1,0:MENU OFF:CLS:SetTitle mo$(1):GOSUB DateiNameEingabe
  186.   IF abbruch=1 AND RelOffen=0 THEN
  187.    abbruch=0:WINDOW CLOSE 4:GOSUB st:MENU 1,1,1
  188.    dn$="":c$="":CLS:MENU ON:RETURN
  189.   END IF
  190.   IF dn$="Daten/"+STRING$(14,46)+Suffix$ THEN
  191.    WINDOW CLOSE 4:GOSUB Info:COLOR 3,0:LOCATE 3,5:PRINT ra$(6)
  192.    GOSUB 650:WINDOW CLOSE 5:GOSUB st:MENU 1,1,1
  193.    dn$="":c$="":CLS:MENU ON:RETURN
  194.   END IF
  195.   GOSUB DNam:CALL Dateitest(dn$,erg&)
  196.   IF erg&>0 THEN
  197.     LOCATE 10,24:PRINT"Die Datei existiert bereits!"
  198.     Requester" Überschreiben?","JA","  NEIN"
  199.     IF req=2 THEN
  200.       GOSUB st:MENU 1,1,1:dn$="":c$="":CLS:MENU ON:RETURN
  201.       ELSE
  202.       loesch$=dn$:KILL loesch$:loesch$=""
  203.     END IF
  204.   END IF
  205.   Requester"Alles OK?","JA","  NEIN"
  206.   ON req GOTO Wa2,Wb2
  207. Wa2: gespeichert=1:GOTO Eingabe
  208. Wb2: GOTO Einrichten
  209. Oeffnen2:
  210.  OPEN"R",#2,dn$,Satzlaenge
  211.  FIELD#2,8 AS a$(0),8 AS a$(1),8 AS a$(2),8 AS a$(3),29 AS a$(4),29 AS a$(5),868 AS b$,3 AS c$(0),60 AS c$(1),60 AS c$(2)
  212.  an=LOF(2)/Satzlaenge:RelOffen=1:RETURN
  213. '-------
  214. Eingabe:
  215. '-------
  216.   IF RelOffen=0 THEN GOSUB Oeffnen2:fa=0
  217.   SatzNr=an+1:CALL ActivateWindow&(wpr&)
  218.   CLS:SetTitle mo$(3):GOSUB MenuesAus:GOSUB Rahmen
  219. Eingabe2:
  220.   IF an=n THEN
  221.     GOSUB Info:PRINT:PRINT ra$(3):GOSUB 650
  222.     WINDOW CLOSE 5:GOSUB MenuesAn:MENU 1,1,0:GOTO DatAus
  223.   END IF
  224.   GOSUB Loeschen
  225.   LOCATE 1,2:COLOR 2:PRINT"Kuvertnummer:";:COLOR 1:PRINT an+1
  226.   LOCATE 1,23:COLOR 2:PRINT"Frei BASIC:";:COLOR 1:PRINT FRE(1)
  227.   LOCATE 1,44:COLOR 2:PRINT"Frei System:";:COLOR 1:PRINT FRE(-1)
  228.   LOCATE 3,2:COLOR 2:PRINT"Datens. belegt:";:COLOR 1:PRINT an:COLOR 2
  229.   LOCATE 3,23:PRINT"Datens. frei:";:COLOR 1:PRINT n-an:COLOR 2
  230.   LOCATE 3,44:PRINT"Dateiname: ";:COLOR 1:PRINT LEFT$(dn$,20)
  231.   LOCATE 5,8:PRINT"Nr.:":LOCATE 5,25:PRINT"TA:"
  232.   LOCATE 5,41:PRINT"NR:":LOCATE 5,58:PRINT"LÄN:"
  233.   LOCATE 6,8:PRINT"A:":LOCATE 6,41:PRINT"B:":GOSUB NrAB
  234. Nein:  
  235. IF fa=1 THEN
  236.   c$=a$(0):getline 5,12,8,c$,3,0: LSET a$(0)=c$           'Kopf
  237.   c$=a$(1):getline 5,28,8,c$,3,0: LSET a$(1)=c$
  238.   c$=a$(2):getline 5,44,8,c$,3,0: LSET a$(2)=c$
  239.   c$=a$(3):getline 5,62,8,c$,3,0: LSET a$(3)=c$
  240.   c$=a$(4):getline 6,10,29,c$,3,0:LSET a$(4)=c$
  241.   c$=a$(5):getline 6,43,29,c$,3,0:LSET a$(5)=c$
  242. ELSE
  243.   c$="        ":getline 5,12,8,c$,3,0: LSET a$(0)=c$
  244.   c$="Chrome  ":getline 5,28,8,c$,3,0: LSET a$(1)=c$
  245.   c$="DOLBY C ":getline 5,44,8,c$,3,0: LSET a$(2)=c$
  246.   c$="90      ":getline 5,62,8,c$,3,0: LSET a$(3)=c$
  247.   c$=SPACE$(29):getline 6,10,29,c$,3,0:LSET a$(4)=c$
  248.   c$=SPACE$(29):getline 6,43,29,c$,3,0:LSET a$(5)=c$
  249. END IF
  250. '--------------------------------------------------------- Seite A
  251.   IF fa=1 THEN FOR f=0 TO 13:f$(f)=b$(f):NEXT f:GOTO Nein1  
  252.   FOR i=0 TO 13:f$(i)=STRING$(la(i),32):NEXT i
  253. Nein1:    
  254.   intext 13,8,8,la(),f$(),3,0
  255.   FOR f=0 TO 13:b$(f)=f$(f):AB$=AB$+b$(f):NEXT f
  256. '--------------------------------------------------------- Seite B
  257.   IF fa=1 THEN FOR f=0 TO 13:f$(f)=b$(f+14):NEXT f:GOTO Nein2
  258.   FOR f=0 TO 13:f$(f)=STRING$(la(f),32):NEXT f
  259. Nein2: 
  260.   intext 13,8,41,la(),f$(),3,0
  261.   FOR f=0 TO 13:b$(f+14)=f$(f):AB$=AB$+b$(f+14):NEXT f
  262.   LSET b$=AB$:AB$=""
  263. '--------------------------------------------------------- Fuß
  264.   IF fa=1 THEN FOR f=0 TO 2:f$(f)=c$(f):NEXT f:GOTO Nein3
  265.   FOR f=0 TO 2:f$(f)=STRING$(la1(f),32):NEXT f
  266. Nein3:
  267.   intext 2,23,12,la1(),f$(),3,0
  268.   FOR f=0 TO 2:LSET c$(f)=f$(f):NEXT f
  269. '---------------------------------------------------------
  270.   WINDOW 8,"Eingaben OK?",(200,100)-(440,150),0,SNr
  271.   LINE(20,10)-(80,40),2,bf:LINE(90,10)-(150,40),2,bf
  272.   LINE(160,10)-(220,40),2,bf:COLOR 1,2
  273.   LOCATE 4,1:PRINT PTAB(42)"JA";PTAB(104)"NEIN";PTAB(163)"ABBRUCH":COLOR 1,0
  274. Wa3:
  275.   WHILE MOUSE(0)=0:GOSUB Paint3:SLEEP:WEND
  276.   tst=MOUSE(0):x=MOUSE(1):y=MOUSE(2):win=WINDOW(0) 
  277.   IF win<>8 THEN Wa3
  278.   IF win=8 AND y>10 AND y<40 THEN                
  279.     IF x>20 AND x<80 THEN
  280.       xp=22:PAINT(xp,12),1,0:px=xp:IF MOUSE(0)<0 THEN Wa3
  281.       WINDOW CLOSE 8:GOSUB SatzSchreiben:fa=0:GOTO Eingabe2
  282.     END IF
  283.     IF x>90  AND x<150 THEN
  284.       xp=92:PAINT(xp,12),1,0:px=xp:IF MOUSE(0)<0 THEN Wa3
  285.       WINDOW CLOSE 8:fa=1:GOTO Nein
  286.     END IF
  287.     IF x>160 AND x<220 THEN
  288.       xp=162:PAINT(xp,12),1,0:px=xp:IF MOUSE(0)<0 THEN Wa3 
  289.       WINDOW CLOSE 8:GOSUB SatzSchreiben:tt=1:bst=1:fa=0
  290.       CLOSE #2:RelOffen=0:GOSUB MenuesAn:MENU 2,1,1:GOTO DatAus
  291.     END IF
  292.   END IF
  293. GOTO Wa3
  294. Paint3:
  295.   PAINT(px,12),2,0:COLOR 1,2
  296.   LOCATE 4,1:PRINT PTAB(42)"JA";PTAB(104)"NEIN";PTAB(163)"ABBRUCH":COLOR 1,0
  297. RETURN
  298. SatzSchreiben:
  299.   PUT #2,SatzNr:an=SatzNr:SatzNr=SatzNr+1:RETURN  
  300. '-----
  301. Farbe:
  302. '-----
  303.   Farbwahl
  304. RETURN
  305. KuvertSuchen:
  306.   MENU OFF:SetTitle"Kuvert suchen"
  307.   wt$="Kuvertnummer eingeben: ":GOSUB OpenWin4
  308.   c$=STRING$(3,32):getline 2,3,3,c$,3,0
  309.   IF abbruch=1 THEN
  310.    abbruch=0:WINDOW CLOSE 4:GOSUB ModusSetzen:MENU ON:RETURN
  311.    END IF
  312.   IF c$=SPACE$(3) THEN
  313.    WINDOW CLOSE 4:GOSUB Info:LOCATE 3,5:COLOR 3,0:PRINT ra$(6)
  314.    GOSUB 650:WINDOW CLOSE 5:GOSUB ModusSetzen:MENU ON:RETURN
  315.   END IF
  316.   record=VAL(c$)
  317.   IF record<1 OR record>an THEN
  318.     WINDOW CLOSE 4:GOSUB Info:LOCATE 3,1:COLOR 3
  319.     PRINT"Nur Kuvert ";:COLOR 1:PRINT"1 bis "an:GOSUB 650
  320.     WINDOW CLOSE 5:GOTO KuvertSuchen
  321.   END IF
  322.   WINDOW CLOSE 4:r=record:GOSUB ModusSetzen:MENU ON:RETURN
  323. ModusSetzen: SetTitle mo$(4):RETURN
  324. KuvertLoeschen:
  325.   SetTitle"Kuvert löschen"
  326.   Requester"Kuvert löschen?","JA","ABBRUCH"
  327.   ON req GOTO JaL,NeinL
  328. JaL:  GOSUB Info:LOCATE 2,2:PRINT"Diese Funktion ist"
  329.       PRINT "noch nicht":PRINT "implementiert!":GOSUB 650:WINDOW CLOSE 5
  330. NeinL:  GOSUB ModusSetzen:RETURN
  331. '------
  332. DatAus:
  333. '------
  334.   IF RelOffen=0 THEN GOSUB Oeffnen2
  335.   GOSUB ModusSetzen:GOSUB Kopfzeile:GOSUB Rahmen:GOSUB NrAB
  336.   MENU 1,0,1:MENU 1,3,1:MENU 2,1,1:MENU 3,0,1:MENU ON 
  337. KaL:              
  338.   IF r>an THEN r=an
  339.   IF r<1 THEN r=1
  340.   GET #2,r:GOSUB Loeschen
  341.   LOCATE 1,15:PRINT r
  342.   LOCATE 5,12:PRINT a$(0):LOCATE 5,28:PRINT a$(1)
  343.   LOCATE 5,44:PRINT a$(2):LOCATE 5,62:PRINT a$(3)
  344.   LOCATE 6,10:PRINT a$(4):LOCATE 6,43:PRINT a$(5)
  345.   z=0:FOR i=1 TO 868 STEP 31:b$(z)=MID$(b$,i,31):z=z+1:NEXT i
  346.   FOR f=0 TO 13
  347.     LOCATE 8+f,8:PRINT b$(f):LOCATE 8+f,41:PRINT b$(f+14)
  348.   NEXT f
  349.   FOR f=0 TO 2:LOCATE 23+f,12:PRINT c$(f):NEXT f
  350.   IF r=1 THEN  
  351.     MENU OFF:SOUND 1000,4,255,0:GOSUB Info:LOCATE 3,9:COLOR 3,0
  352.     PRINT ra$(1):COLOR 1:GOSUB 650:WINDOW CLOSE 5:MENU ON
  353.   END IF
  354.   IF r=an THEN 
  355.     MENU OFF:SOUND 1000,4,255,0:GOSUB Info:LOCATE 3,10:COLOR 3,0
  356.     PRINT ra$(2):COLOR 1:GOSUB 650:WINDOW CLOSE 5:MENU ON
  357.   END IF
  358.   IF tt=1 THEN tt=0:GOSUB ModusSetzen
  359.   IF bs=1 AND bst=1 THEN bst=0:GOSUB ScnT
  360. Wa4:
  361.   tst=MOUSE(0)
  362.   WHILE MOUSE(0)=0:SLEEP:WEND:x=MOUSE(3):y=MOUSE(4):win=WINDOW(0)  
  363.   IF win<>3 THEN Wa4
  364.   IF y>0 AND y<10 AND win=3 THEN
  365.     IF x>12  AND x<104 THEN GOSUB Aendern:GOTO KaL
  366.     IF x>114 AND x<206 THEN r=1 :GOTO KaL  'ANFANG
  367.     IF x>215 AND x<259 THEN r=r-1:GOTO KaL '<<<
  368.     IF x>265 AND x<309 THEN
  369.       IF MOUSE(0)<0 THEN Wa4
  370.       r=r-1:GOTO KaL '<
  371.     END IF
  372.     IF x>315 AND x<359 THEN
  373.       IF MOUSE(0)<0 THEN Wa4
  374.       r=r+1:GOTO KaL '>
  375.     END IF
  376.     IF x>365 AND x<409  THEN r=r+1:GOTO KaL '>>>
  377.     IF x>418 AND x<510 THEN r=an:GOTO KaL  'ENDE
  378.     IF x>520 AND x<612 THEN GOSUB KuvertLoeschen:GOTO Wa4
  379.   END IF
  380.   IF y>14 AND y<25 AND win=3 THEN
  381.     IF x>12 AND x<206 THEN
  382.       IF MOUSE(0)<0 THEN Wa4
  383.       GOSUB KuvertSuchen:GOTO KaL
  384.     END IF
  385.     IF x>215 AND x<409 THEN GOSUB Kuvert
  386.     IF x>418 AND x<510 THEN GOSUB FettDruck
  387.     IF x>520 AND x<612 THEN GOSUB DoppelDruck
  388.   END IF
  389. GOTO Wa4
  390. FettDruck:
  391.   Requester"Fettdruck?","JA","  NEIN"
  392.   IF req=1 THEN Fett=1:Doppel=0:RETURN
  393.   IF req=2 THEN Fett=0:Doppel=0:RETURN
  394. DoppelDruck:
  395.   Requester"Doppeldruck?","JA","  NEIN"
  396.   IF req=1 THEN Doppel=1:Fett=0:RETURN
  397.   IF req=2 THEN Doppel=0:Fett=0:RETURN
  398. Aendern:
  399.   CALL ActivateWindow&(wpr&)   
  400.   MENU OFF:SetTitle"Kuvert ändern"
  401.   c$=a$(0):getline 5,12,8,c$,3,0: LSET a$(0)=c$ 'Kopf
  402.   c$=a$(1):getline 5,28,8,c$,3,0: LSET a$(1)=c$
  403.   c$=a$(2):getline 5,44,8,c$,3,0: LSET a$(2)=c$ 
  404.   c$=a$(3):getline 5,62,8,c$,3,0: LSET a$(3)=c$
  405.   c$=a$(4):getline 6,10,29,c$,3,0:LSET a$(4)=c$
  406.   c$=a$(5):getline 6,43,29,c$,3,0:LSET a$(5)=c$
  407. '----------------------------------------------- Seite A  
  408.   FOR f=0 TO 13:f$(f)=b$(f):NEXT f
  409.   intext 13,8,8,la(),f$(),3,0
  410.   FOR f=0 TO 13:b$(f)=f$(f):AB$=AB$+b$(f):NEXT f
  411. '----------------------------------------------- Seite B  
  412.   FOR f=0 TO 13:f$(f)=b$(f+14):NEXT f
  413.   intext 13,8,41,la(),f$(),3,0
  414.   FOR f=0 TO 13:b$(f+14)=f$(f):AB$=AB$+b$(f+14):NEXT f
  415.   LSET b$=AB$:AB$=""
  416. '----------------------------------------------- Fuß  
  417.   FOR f=0 TO 2:f$(f)=c$(f):NEXT f
  418.   intext 2,23,12,la1(),f$(),3,0
  419.   FOR f=0 TO 2:LSET c$(f)=f$(f):NEXT f:PUT #2,r
  420. '-----------------------------------------------
  421.   GOSUB Info:LOCATE 3,5:COLOR 3:PRINT"Kuvert geändert":COLOR 1:GOSUB 650
  422.   WINDOW CLOSE 5:GOSUB ModusSetzen:MENU ON:RETURN
  423. '-----
  424. Laden:
  425. '-----
  426.   WINDOW 12,,(142,36)-(461,168),0,SNr 
  427.   openreq=1:qo=0:x=0:y=0:MENU 1,1,0:GOSUB MenuesAus
  428.   SetTitle mo$(8):pa1=0:qa=1
  429.   LINE (5,5)-(315,136),1,b:LINE (7,7)-(313,134),1,b
  430.   LINE (14,29)-(292,91),1,b:LINE (292,29)-(307,91),1,b  
  431.   LINE(292,29)-(307,49),1,b:LINE(292,71)-(307,91),1,b
  432.   LINE(294,31)-(305,47),2,bf:LINE(294,73)-(305,89),2,bf
  433.   LINE (13,99)-(307,113),1,b
  434.   LINE (14,116)-(154,131),1,b:LINE (16,118)-(152,129),2,bf
  435.   LINE (167,116)-(307,131),1,b:LINE (169,118)-(305,129),2,bf:COLOR 2,0
  436.   LOCATE 3,4:PRINT "Dateinamen":LOCATE 3,21:PRINT"Bytes"
  437.   LOCATE 3,31:PRINT "Blöcke":COLOR 1,2
  438.   LOCATE 16,9:PRINT"Öffnen":LOCATE 16,27:PRINT"Abbruch":COLOR 1,0
  439.   IF gespeichert=1 THEN
  440.     FOR i=0 TO anz:DirName$(i)="":DirSize&(i)=0:DirBlks&(i)=0:NEXT i
  441.     SetTitle "Verzeichnis lesen":Dir$="Daten":GOSUB GetDir
  442.     gespeichert=0:SortDir:SetTitle mo$(8)
  443.   END IF
  444.   FOR i=1 TO 7
  445.     IF DirSize&(i)=0 THEN lweiter
  446.     LOCATE 4+i,4:PRINT LEFT$(DirName$(i),14)
  447.     LOCATE 4+i,20:PRINT DirSize&(i)
  448.     LOCATE 4+i,30:PRINT DirBlks&(i)
  449.   lweiter:
  450.   NEXT i
  451. Wa6:
  452.   WHILE MOUSE(0)=0:GOSUB Paint4:SLEEP:WEND
  453.   tst=MOUSE(0):x=MOUSE(1):y=MOUSE(2):win=WINDOW(0)
  454.   IF win<>12 THEN Wa6
  455.   IF win=12 AND openreq=1 THEN
  456.     IF x>294 AND x<305 AND y>31 AND y<47 THEN
  457.       IF pa1=0 THEN xp=296:yp=33:PAINT(xp,yp),1,0:px=xp:py=yp:pa1=1
  458.       GOSUB Sab 'scroll ab
  459.     END IF
  460.     IF x>294 AND x<305 AND y>73 AND y<89 THEN
  461.       IF pa1=0 THEN xp=296:yp=75:PAINT(xp,yp),1,0:px=xp:py=yp:pa1=1
  462.       GOSUB Sauf 'scroll auf
  463.     END IF
  464.     IF x>16 AND x<152 AND y>118 AND y<129 THEN
  465.       xp=18:yp=120:PAINT(xp,yp),1,0:px=xp:py=yp:IF MOUSE(0)<0 THEN Wa6
  466.       GOTO DOpen 'Datei öffnen
  467.     END IF
  468.     IF x>169 AND x<305 AND y>118 AND y<129 THEN
  469.       xp=171:yp=120:PAINT(xp,yp),1,0:px=xp:py=yp:IF MOUSE(0)<0 THEN Wa6
  470.       GOTO OEnd 'Abbruch
  471.     END IF
  472.     IF x>14 AND x<292 AND y>29 AND y<91 THEN
  473.       IF MOUSE(0)<0 THEN Wa6
  474.       GOSUB PText 'Print Text in Req
  475.     END IF 
  476.   END IF
  477.   pa1=0
  478. GOTO Wa6
  479. Sab:
  480.   IF DirSize&(qa-1)=0 OR counter<7 OR qa=1 THEN RETURN
  481.   SCROLL (15,31)-(291,87),0,8
  482.   LOCATE 5,4:PRINT LEFT$(DirName$(qa-1),14)
  483.   LOCATE 5,20:PRINT DirSize&(qa-1)
  484.   LOCATE 5,30:PRINT DirBlks&(qa-1)
  485.   qa=qa-1:RETURN
  486. Sauf:
  487.   IF DirSize&(qa+7)=0 OR counter<7 OR qa=counter-6 THEN RETURN
  488.   SCROLL (15,31)-(291,87),0,-8
  489.   LOCATE 11,4:PRINT LEFT$(DirName$(qa+7),14)
  490.   LOCATE 11,20:PRINT DirSize&(qa+7)
  491.   LOCATE 11,30:PRINT DirBlks&(qa+7)
  492.   qa=qa+1:RETURN
  493. OEnd:
  494. IF RelOffen=0 THEN
  495.    openreq=0:CLS:GOSUB st
  496.    MENU 1,0,1:MENU 1,1,1:MENU 1,3,0:WINDOW CLOSE 12:MENU ON:RETURN
  497. END IF
  498. IF RelOffen=1 THEN
  499.   openreq=0:GOSUB ModusSetzen:WINDOW CLOSE 12:GOSUB MenuesAn:RETURN
  500. END IF
  501. Paint4:
  502.   PAINT(px,py),2,0:COLOR 1,2
  503.   LOCATE 16,9:PRINT"Öffnen":LOCATE 16,27:PRINT"Abbruch":COLOR 1,0
  504. RETURN
  505. PText:
  506.   qo=INT((y-31)/8)+qa
  507.   IF qo>counter THEN qo=counter
  508.   LINE(14,100)-(306,112),0,bf
  509.   LOCATE 14,4:PRINT LEFT$(DirName$(qo),14)
  510.   IF DirSize&(qo)=0 THEN RETURN
  511.   LOCATE 14,20:PRINT DirSize&(qo)
  512.   LOCATE 14,30:PRINT DirBlks&(qo)
  513. RETURN
  514. DOpen:
  515.   IF LEFT$(DirName$(qo),14)="" THEN Wa6
  516.   CLS:WINDOW CLOSE 12
  517.   IF RelOffen=1 THEN CLOSE 2:RelOffen=0:GOSUB Schliessen:SetTitle mo$(8)
  518.   dn$="Daten/"+DirName$(qo)
  519.   Dateigroesse&=DirSize&(qo)
  520.   GOSUB MenuesAn:r=1:tt=1:GOTO DatAus
  521. '----------
  522. Schliessen:
  523. '----------
  524.   MENU OFF:SetTitle"Schließe Datei":CLS
  525.   IF RelOffen=1 THEN CLOSE 2:RelOffen=0
  526.   FOR i=0 TO 5:a$(i)="":NEXT i:b$="":
  527.   FOR i=0 TO m:b$(i)="":f$(i)="":NEXT i
  528.   FOR i=0 TO 2:c$(i)="":NEXT i
  529.   dn$="":an=0:MENU ON
  530.   IF MENU(1)=3 THEN GOSUB mod7:MENU ON:RETURN Wa1
  531.  RETURN
  532. mod7:
  533.   GOSUB st:GOSUB MenuesAus:MENU 1,0,1:MENU 1,1,1:MENU 1,3,0
  534. RETURN
  535. '-------------
  536. DateiLoeschen:
  537. '-------------
  538.   MENU OFF:SetTitle mo$(9)
  539.   wt$="Dateinamen eingeben: ":GOSUB OpenWin4
  540.   c$=STRING$(14,32):getline 2,3,14,c$,3,0
  541.   c$=LEFT$(c$,p-1):FOR f=LEN(c$) TO 13:c$=c$+fuell$:NEXT f
  542.   IF abbruch=1 AND RelOffen=0 THEN
  543.     abbruch=0:WINDOW CLOSE 4:GOSUB st:MENU ON:RETURN
  544.   END IF
  545.   IF abbruch=1 AND RelOffen=1 THEN
  546.     abbruch=0:WINDOW CLOSE 4:GOSUB ModusSetzen:MENU ON:RETURN
  547.   END IF
  548.   IF c$=STRING$(14,46) AND RelOffen=1 THEN
  549.     c$="":WINDOW CLOSE 4:GOSUB Info:LOCATE 3,5:COLOR 3,0:PRINT ra$(6)
  550.     GOSUB 650:WINDOW CLOSE 5:GOSUB ModusSetzen:MENU ON:RETURN
  551.   END IF
  552.   IF c$=STRING$(14,46) AND RelOffen=0 THEN
  553.     c$="":WINDOW CLOSE 4:GOSUB Info:LOCATE 3,5:COLOR 3,0:PRINT ra$(6)
  554.     GOSUB 650:WINDOW CLOSE 5:GOSUB st:MENU ON:RETURN
  555.   END IF
  556.   WINDOW CLOSE 4:GOSUB Info
  557.   loesch$="Daten/"+c$+Suffix$:KILL loesch$
  558.   COLOR 3:PRINT"Datei:":COLOR 1
  559.   PRINT LEFT$(loesch$,14):PRINT " ist gelöscht."
  560.   GOSUB 650:WINDOW CLOSE 5:gespeichert=1
  561.   IF RelOffen=1 THEN GOSUB ModusSetzen:MENU ON:RETURN
  562.   IF RelOffen=0 THEN GOSUB st:MENU ON:RETURN
  563. '----
  564. Verz:
  565. '----             
  566.   MENU OFF:WINDOW 8,,(205,40)-(425,185),0,SNr
  567.   FILES "Daten"
  568.   COLOR 3:PRINT TAB(3)"Linke Maustaste drÜcken":COLOR 1
  569.   Vz:
  570.   tst=MOUSE(0):WHILE MOUSE(0)=0:WEND:x=MOUSE(1):y=MOUSE(2)
  571.   IF x>1 AND x<WINDOW(2) AND y>1 AND y<WINDOW(3) AND WINDOW(0)=8 THEN
  572.     WINDOW CLOSE 8:MENU ON:RETURN
  573.   END IF
  574.   GOTO Vz
  575. '---- 
  576. Ende:
  577. '----
  578.   SetTitle mo$(10):Requester"ZUM MENÜ?  ","JA","  NEIN"
  579.   ON req GOTO JaEnde,NeinEnde
  580. JaEnde:
  581.   MENU RESET:LIBRARY CLOSE:WINDOW CLOSE 3:CLOSE 2
  582.   IF bs=1 THEN SCREEN CLOSE SNr
  583.   WINDOW 1,"BASIC",(0,0)-(617,241),31,-1
  584.   RUN "KKK.MENUE"
  585. NeinEnde:
  586.   IF RelOffen=0 THEN GOSUB st:RETURN
  587.   IF RelOffen=1 THEN DatAus
  588. '------
  589. Kuvert:
  590. '------   
  591.   SetTitle"Ein Kuvert drucken"
  592.   Requester"Drucker OK?","JA","ABBRUCH"
  593.   IF req=1 THEN Drucken
  594.   IF req=2 THEN GOSUB ModusSetzen:RETURN
  595. Drucken:
  596.   MENU OFF
  597.   GOSUB Info:LOCATE 3,2:COLOR 3:PRINT"Drucke Kuvert";:COLOR 1:PRINT r
  598.   OPEN "prt:" FOR OUTPUT AS 1
  599.   PRINT#1,InitPrinter$;NoMargin$;CondOn$;NLQOn$;
  600.   IF Fett=1 THEN PRINT#1,CHR$(27)+"[1m"       :REM Fettdruck ein
  601.   IF Fett=0 THEN PRINT#1,CHR$(27)+"[22m"      :REM Fettdruck aus
  602. IF Doppel=1 THEN PRINT#1,CHR$(27)+"[4"+af$+"z":REM Doppeldruck ein
  603. IF Doppel=0 THEN PRINT#1,CHR$(27)+"[3"+af$+"z":REM Doppeldruck aus
  604. '-------------------------------------------------- Kopf
  605.   FOR i=0 TO 67:PRINT#1,"_";:NEXT i
  606.   PRINT#1,"":PRINT#1,"| ";
  607.   FOR i=0 TO 3:PRINT#1,tf$(i);a$(i)"     ";:NEXT i
  608.   PRINT#1,"|"
  609.   PRINT#1,UndlnOn$;
  610.   PRINT#1,"| A:";a$(4)"   ";"B:";a$(5)" ";
  611.   PRINT#1,UndlnOff$ "|"
  612. '-------------------------------------------------- Seite A/B Titel
  613.   FOR i=0 TO 12
  614.     PRINT#1,"| "b$(i)" | "b$(i+14)" |"
  615.   NEXT
  616.   PRINT#1,UndlnOn$;"| ";b$(13);" | ";b$(27);" ";UndlnOff$;"|"
  617. '-------------------------------------------------- Fuß
  618.   PRINT#1,"| Nr: ";c$(0)
  619.   PRINT#1,"|  A: ";c$(1);"  |"
  620.   PRINT#1,UndlnOn$;"|  B: ";c$(2);"  "
  621.   PRINT#1,UndlnOff$;
  622. '--------------------------------------------------
  623.   FOR i=0 TO 2:PRINT#1,"|"SPACE$(67)"|":NEXT
  624.   pr$="| Datei:"+LEFT$(dn$,20)
  625.   PRINT#1,UndlnOn$;pr$;LEFT$(SPACE$(68),68-LEN(pr$));UndlnOff$ "| "
  626.   PRINT#1,InitPrinter$
  627.   dr=dr+1:IF dr=2 THEN dr=0:PRINT #1,CHR$(12)
  628. WINDOW CLOSE 5:CLOSE #1:GOSUB ModusSetzen:MENU ON:RETURN
  629. OpenWin11:
  630.   MENU OFF:MENU 3,0,0:WINDOW 11,WinText$,(50,37)-(572,166),8,SNr
  631.   COLOR 0,1:CLS
  632. RETURN  
  633. Prg:
  634.   WinText$="Das Programm":GOSUB OpenWin11
  635.   LOCATE 2,8:PRINT Version$
  636.   LOCATE 4,7:PRINT" Von Lothar Berndt, 4240 Emmerich 1"
  637.   LOCATE 6,7:PRINT" Erstellt im Jahr 1990"
  638.   LOCATE 8,7:PRINT n"Datensätze pro Datei"
  639.   LOCATE 10,7:PRINT" 28 Titel pro Kuvert"
  640.   LOCATE 12,7:PRINT" Feldlänge 31 Zeichen";
  641. GOTO modus6
  642. Datei:
  643.   WinText$="Datei":GOSUB OpenWin11
  644.   LOCATE 5,4:PRINT"Aktuelle Datei..............: "LEFT$(dn$,20)
  645.   LOCATE 6,4:PRINT"Dateigröße in Bytes.........:";Dateigroesse&
  646.   LOCATE 7,4:PRINT"Feie Bytes Systemspeicher...:"FRE(-1)
  647.   LOCATE 8,4:PRINT"Anzahl Datensätze ..........:";an
  648.   LOCATE 9,4:PRINT"Anzahl Felder...............:";m+1+9
  649.   LOCATE 10,4:PRINT"Datensatzlänge..............:";Satzlaenge 
  650. GOTO modus6
  651. DFormat:
  652.   WinText$="Format":GOSUB OpenWin11
  653.   LOCATE 2,5:PRINT"Nr., TA, NR, LÄN    je  8 Zeichen"
  654.   LOCATE 4,5:PRINT"A: und B: Kopfzeile je 29 Zeichen"
  655.   LOCATE 6,5:PRINT"Felder fÜr Titel    je 31 Zeichen"
  656.   LOCATE 8,5:PRINT"Nr:                    ";la1(0);"Zeichen"
  657.   LOCATE 9,5:PRINT" A:                   ";la1(1);"Zeichen"
  658.  LOCATE 10,5:PRINT" B:                   ";la1(2);"Zeichen"
  659. GOTO modus6
  660. Kdruck:
  661.   WinText$="Kuvert drucken":GOSUB OpenWin11
  662.   PRINT 
  663.   PRINT" Vorgesehen ist der Druck auf Einzelblätter im  Format  DIN  A4."
  664.   PRINT" Vier KassettenhÜllen passen auf ein DIN A4-Blatt.  Auf die lin-"
  665.   PRINT" ke Seite des Blattes werden zwei HÜllen untereinander gedruckt."
  666.   PRINT" Dann wird  durch  ein  FF (Form Feed) an den Drucker, das Blatt"
  667.   PRINT" ausgeworfen.  Um die anderen zwei HÜllen zu drucken,  dreht man"
  668.   PRINT" das Blatt um 180° und steckt es erneut in den Drucker.  Drucken"
  669.   PRINT" auf Endlospapier ist auch  möglich.  Um  Papier zu sparen, kann"
  670.   PRINT" man nach dem drucken der Hälfte,  das  Papier  abtrennen und um"
  671.   PRINT" 180° gedreht, erneut durchlaufen lassen."
  672. GOTO modus6  
  673. Tas:
  674.   WinText$="Tastaturbelegung beim eingeben/ändern":GOSUB OpenWin11
  675.   PRINT 
  676.   PRINT" RETURN       = ein Feld tiefer, leere Felder  werden als"
  677.   PRINT"                Leerfelder gesichert ( chr$(32) )!"
  678.   PRINT" CURSORTASTEN = ab, auf, rechts, links."
  679.   PRINT" DEL          = löscht ein Zeichen unter dem Cursor,"
  680.   PRINT"                nachfolgende Zeichen rÜcken nach links.
  681.   PRINT" BACKSPACE    = löscht ein Zeichen links  vom Cursor,"
  682.   PRINT"                nachfolgende Zeichen rÜcken nach links."
  683.   PRINT" F10          = löscht das aktuelle Feld (wo der Cursor ist)."
  684.   PRINT" ESC          = erzwingt den Abbruch der Eingabe im aktuellen" 
  685.   PRINT"                Feld. Da die Felder vorher mit Leerzeichen"
  686.   PRINT"                gefÜllt wurden, werden leere Felder als" 
  687.   PRINT"                Leerfelder gesichert (wie bei RETURN)!"
  688.   PRINT" SPACE        = schiebt den Text rechts vom Cursor nach rechts."
  689.   PRINT" LINKE MAUST. = positioniert den Cursor wo d. Mauszeiger steht.";
  690. modus6:
  691.   WHILE (WINDOW(7)<>0 AND WINDOW(1)=11):WEND
  692.   WINDOW CLOSE 11:WINDOW OUTPUT WNr:MENU 3,0,1:MENU ON:tst=MOUSE(0)
  693.   COLOR 1,0:RETURN
  694. '------
  695. Fehler:
  696. '------
  697.   MENU OFF
  698.   IF ERR=14 THEN Fehler$="Arbeitsspeicher nicht ausreichend."
  699.   IF ERR=49 THEN Fehler$="Legen Sie die Diskette in das Laufwerk!"
  700.   IF ERR=52 THEN Fehler$="Falsche Dateinummer."
  701.   IF ERR=53 THEN Fehler$="Datei nicht gefunden."
  702.   IF ERR=54 THEN Fehler$="Falscher Dateityp."
  703.   IF ERR=55 THEN Fehler$="Die Datei ist bereits geöffnet."
  704.   IF ERR=57 THEN Fehler$="Geräte Ein- Ausgabefehler."
  705.   IF ERR=61 THEN Fehler$="Diskette ist voll."
  706.   IF ERR=62 THEN Fehler$="Eingabe nach logischem Dateiende."
  707.   IF ERR=63 THEN Fehler$="UngÜltige Satznummer."
  708.   IF ERR=64 THEN Fehler$="Ungültiger Dateiname."
  709.   IF ERR=68 THEN Fehler$="Gerät ist nicht verfÜgbar."
  710.   IF ERR=70 THEN Fehler$="Diskette ist schreibgeschÜtzt."
  711.   IF ERR=74 THEN Fehler$="Unbekannte Diskette."
  712.   IF ERR=75 THEN Fehler$="Verzeichnis existiert nicht!"
  713.   IF ERR=76 THEN Fehler$="Kein Speicherplatz frei!"
  714.   IF ERR=77 THEN Fehler$="Verzeichnis konnte nicht gefunden werden!
  715.   WINDOW 99,,(0,150)-(630,185),0,SNr
  716.   LOCATE 1,3:PRINT"Es ist ein Fehler aufgetreten."
  717.   LOCATE 3,3:COLOR 3:PRINT ERR;" ";Fehler$:COLOR 1
  718.   LOCATE 5,3:PRINT"Beheben Sie den Fehler und drÜcken danach die Taste 'W'.";
  719. Wa5: x$=INKEY$:IF x$="" THEN Wa5
  720.   IF UCASE$(x$)<>"W" THEN Wa5
  721.   WINDOW CLOSE 99:Fehler$="":MENU ON
  722.   IF ERR=49 OR ERR=61 OR ERR=70 THEN
  723.     RESUME
  724.   ELSE
  725.     RESUME FehlerEnd
  726.   END IF
  727. FehlerEnd:
  728.   ON ERROR GOTO 0:WINDOW WNr:CLS:GOSUB Schliessen:GOSUB mod7
  729.   WinText$="<--- WEITER":GOSUB OpenWin11:COLOR 3,1:PRINT 
  730.   PRINT TAB(26)"KEINE PANIK":COLOR 0,1:LOCATE 5
  731.   PRINT TAB(10)"Es ist ein Fehler aufgetreten, den ich nicht":PRINT 
  732.   PRINT TAB(7)"beheben konnte. Nach dem schließen dieses Fensters":PRINT 
  733.   PRINT TAB(10)"können Sie eine Datei öffnen oder einrichten."
  734.   GOSUB modus6:ON ERROR GOTO Fehler
  735. RETURN Wa1
  736. '--------
  737. ControlC:
  738. '--------
  739. MENU RESET:LIBRARY CLOSE:WINDOW CLOSE 3:WINDOW CLOSE 1:CLOSE
  740. IF bs=1 THEN SCREEN CLOSE SNr
  741. WINDOW 1,"BASIC",(0,0)-(617,241),31,-1
  742. END
  743. '--------------------------
  744. '*** Sub Unterprogramme ***
  745. '--------------------------
  746. SUB xyPTAB (x,y) STATIC:POKEW WINDOW(8)+36,x:POKEW WINDOW(8)+38,y:END SUB
  747. SUB Dateitest (DNa$,Flag&) STATIC 'dos.bmap
  748.     ln$=DNa$+CHR$(0)
  749.     Flag&=Lock&(SADD(ln$),-2)
  750.     CALL UnLock&(Flag&)
  751. END SUB  
  752. SUB SetTitle (wind$) STATIC 'intuition.bmap
  753.   SHARED wpr&:wind$=wind$+CHR$(0):wt&=SADD(wind$)
  754.   CALL SetWindowTitles&(wpr&,wt&,-1)
  755. END SUB
  756. SUB Requester (me$,m1$,m2$) STATIC
  757.   SHARED req,SNr:MENU OFF
  758.   WINDOW 7,"Requester",(218,160)-(406,210),0,SNr
  759.   LOCATE 2,2:PRINT me$
  760.   LINE(14,28)-(80,42),2,bf:LINE(110,28)-(176,42),2,bf:COLOR 1,2
  761.   LOCATE 5,1:PRINT PTAB(38)m1$;PTAB(116)m2$;:COLOR 1,0
  762.   Wa11:
  763.   tst=MOUSE(0):WHILE MOUSE(0)=0:WEND:x=MOUSE(3):y=MOUSE(4)
  764.   IF WINDOW(0)=7 AND y>28 AND y<42 THEN
  765.     IF x>14 AND x<80 THEN req=1:GOTO EndeSubr   :REM JA
  766.     IF x>110 AND x<176 THEN req=2:GOTO EndeSubr :REM NEIN
  767.   END IF
  768.   GOTO Wa11
  769.   EndeSubr:
  770.   WINDOW CLOSE 7:MENU ON
  771. END SUB
  772.  'Anzahl Zeilen-1,Zeile,Spalte,Laenge(),Daten$(),Cursorfarbe,Hintergrundf.
  773. SUB intext (zeilen,ze,sp,laenge(),x$(),Cf,Hf) STATIC
  774.   SHARED l,p:l=0:p=1:d$="":d=0:liz=0
  775.   FOR i=1 TO 15:d$=INKEY$:d$="":NEXT i :REM Tastaturpuffer leeren
  776. getkey:
  777.   COLOR 1,Cf:LOCATE ze+l,sp+p-1:PRINT MID$(x$(l),p,1);
  778.   IF MOUSE(0)<0 THEN
  779.     x=MOUSE(1):y=MOUSE(2)
  780.     IF x>(sp-1)*8 AND x<(sp+laenge(l))*8 OR x>(sp+laenge(l))*8 THEN
  781.       IF y>(ze-1)*8 AND y<(ze+zeilen)*8 THEN
  782.         COLOR 1,Hf:LOCATE ze+l,sp+p-1:PRINT MID$(x$(l),p,1);
  783.         p=INT(x/8)-sp+2:l=INT(y/8)-ze+1
  784.         IF p>laenge(l) THEN p=laenge(l):GOTO getkey
  785.       END IF
  786.     END IF
  787.   END IF
  788.   d$=INKEY$:IF d$="" THEN SLEEP:GOTO getkey
  789.   IF d$=CHR$(34) THEN d$=CHR$(39)
  790.   d=ASC(d$)
  791.   COLOR 1,Hf:LOCATE ze+l,sp+p-1:PRINT MID$(x$(l),p,1);
  792.   IF d>127 AND d<138 OR d>138 AND d<160 THEN getkey
  793.   IF d>0 AND d<8 OR d>8 AND d<13 OR d>13 AND d<27 THEN getkey
  794.   IF d$=CHR$(27) THEN
  795.     IF liz=1 THEN liz=0:p=laenge(l)+1
  796.     EXIT SUB
  797.   END IF
  798.   IF d$=CHR$(13) THEN
  799.     IF liz=1 THEN liz=0:p=laenge(l)+1
  800.     IF l=zeilen THEN EXIT SUB
  801.     p=1:l=l+1:GOTO getkey
  802.   END IF
  803.   IF d$=CHR$(8) THEN
  804.     IF p>1 THEN
  805.       p=p-1
  806.       x$(l)=LEFT$(x$(l),p-1)+MID$(x$(l),p+1)+" "
  807.       LOCATE ze+l,sp:PRINT x$(l):GOTO getkey
  808.       ELSE
  809.       GOSUB Sod1:GOTO getkey
  810.     END IF
  811.   END IF
  812.   IF d$=CHR$(127) THEN
  813.     IF p>=1 THEN
  814.       x$(l)=LEFT$(x$(l),p-1)+MID$(x$(l),p+1)+" "
  815.       LOCATE ze+l,sp:PRINT x$(l):GOTO getkey
  816.       ELSE
  817.       GOSUB Sod1:GOTO getkey
  818.     END IF
  819.   END IF
  820.   IF d$=CHR$(138) THEN
  821.     x$(l)=SPACE$(laenge(l)):LOCATE ze+l,sp:PRINT x$(l):p=1
  822.     GOTO getkey
  823.   END IF
  824.   ON INSTR(CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),d$)GOTO auf,AB,rechts,links
  825.   IF RIGHT$(x$(l),laenge(l)+1-p)=SPACE$(laenge(l)+1-p) THEN
  826.     MID$(x$(l),p,1)=d$:LOCATE ze+l,sp+p-1:PRINT d$;
  827.     ELSE
  828.     x$(l)=LEFT$(x$(l),p-1)+d$+MID$(x$(l),p,laenge(l)-p)
  829.     LOCATE ze+l,sp:PRINT x$(l) 
  830.   END IF
  831.   IF p=laenge(l) THEN GOSUB Sod1:liz=1:GOTO getkey
  832.   p=p+1  
  833. GOTO getkey
  834. auf:
  835.   IF l=0 THEN GOSUB Sod1:GOTO getkey
  836.   l=l-1
  837.   IF p>laenge(l) THEN p=laenge(l)
  838.   GOTO getkey
  839. AB:
  840.   IF l=zeilen THEN GOSUB Sod1:GOTO getkey
  841.   l=l+1
  842.   IF p>laenge(l) THEN p=laenge(l)
  843.   GOTO getkey
  844. rechts:
  845.   IF p=laenge(l) THEN GOSUB Sod1:GOTO getkey
  846.   p=p+1:GOTO getkey
  847. links:
  848.   IF p=1 THEN GOSUB Sod1:GOTO getkey
  849.   p=p-1:GOTO getkey
  850. Sod1: SOUND 1000,4,255,0:RETURN
  851. END SUB
  852.     'Zeile,Spalte,AnzahlZeichen,Dat$,Cursorfarbe,Hintergrundfarbe
  853. SUB getline (ze,sp,AnzZ,txt$,Cf,Hf) STATIC
  854.   SHARED abbruch,p:p=1:liz=0:d$="":d=0:LOCATE ze,sp:PRINT txt$
  855.   FOR i=1 TO 15:d$=INKEY$:d$="":NEXT i:REM Tastaturpuffer leeren
  856.   getk:
  857.   COLOR 1,Cf:LOCATE ze,sp+p-1:PRINT MID$(txt$,p,1);
  858.   tst=MOUSE(0)
  859.   IF MOUSE(0)<0 THEN
  860.     x=MOUSE(1):y=MOUSE(2)
  861.     IF x>(sp-1)*8 AND x<(sp+AnzZ)*8 THEN
  862.       IF y>(ze-1)*8 AND y<ze*8 THEN
  863.         COLOR 1,Hf:LOCATE ze,sp+p-1:PRINT MID$(txt$,p,1);
  864.         p=INT(x/8)-sp+2:IF p>AnzZ THEN p=AnzZ:GOTO getk
  865.       END IF
  866.     END IF
  867.     IF y>28 AND y<42 AND WINDOW(0)=4 THEN
  868.       IF x>14 AND x<80 THEN abbruch=0:GOTO ausg 'Klick in OK
  869.       IF x>110 AND x<176 THEN abbruch=1:d$="":GOTO ausg 'Klick in ABBR.
  870.     END IF
  871.   END IF
  872.   d$=INKEY$:IF d$="" THEN SLEEP:GOTO getk
  873.   IF d$=CHR$(34) THEN d$=CHR$(39)
  874.   d=ASC(d$)
  875.   COLOR 1,Hf:LOCATE ze,sp+p-1:PRINT MID$(txt$,p,1);
  876. IF d>127 AND d<138 OR d>138 AND d<160 THEN getk
  877. IF d>0 AND d<8 OR d>8 AND d<13 OR d>13 AND d<27 OR d>27 AND d<30 THEN getk
  878.   IF d$=CHR$(13) THEN
  879.     IF liz=1 THEN liz=0:p=AnzZ+1
  880.     ausg:
  881.     EXIT SUB
  882.   END IF
  883.   IF d$=CHR$(8) THEN
  884.     IF p>1 THEN
  885.       p=p-1:txt$=LEFT$(txt$,p-1)+MID$(txt$,p+1)+" "
  886.       LOCATE ze,sp:PRINT txt$:GOTO getk
  887.        ELSE
  888.       GOSUB Sod3:GOTO getk
  889.     END IF
  890.   END IF
  891.   IF d$=CHR$(30) THEN
  892.     IF p=AnzZ THEN GOSUB Sod3:GOTO getk
  893.     p=p+1:GOTO getk
  894.   END IF
  895.   IF d$=CHR$(31) THEN
  896.     IF p=1 THEN GOSUB Sod3:GOTO getk
  897.     p=p-1:GOTO getk
  898.   END IF
  899.   IF d$=CHR$(127) THEN
  900.    IF p>=1 THEN
  901.      txt$=LEFT$(txt$,p-1)+MID$(txt$,p+1)+" "
  902.      LOCATE ze,sp:PRINT txt$:GOTO getk
  903.      ELSE
  904.      GOSUB Sod3:GOTO getk
  905.    END IF
  906.   END IF
  907.   IF d$=CHR$(138) THEN
  908.     txt$=SPACE$(AnzZ):LOCATE ze,sp:PRINT txt$
  909.     p=1:GOTO getk
  910.   END IF
  911.   MID$(txt$,p,1)=d$:LOCATE ze,sp:PRINT txt$
  912.   IF p=AnzZ THEN GOSUB Sod3:liz=1:GOTO getk
  913.   p=p+1:GOTO getk
  914. Sod3: SOUND 1000,4,255,0:RETURN
  915. END SUB
  916. SUB SortDir STATIC
  917.   SHARED counter
  918.   FOR sort1=1 TO counter:FOR sort2=sort1+1 TO counter-1
  919.   IF UCASE$(DirName$(sort1))>UCASE$(DirName$(sort2)) THEN
  920.     SWAP DirName$(sort1),DirName$(sort2)
  921.     SWAP DirSize&(sort1),DirSize&(sort2)
  922.     SWAP DirBlks&(sort1),DirBlks&(sort2)
  923.   END IF
  924.   NEXT sort2:NEXT sort1
  925. END SUB
  926. REM Subroutine Farbwahl, aus Amiga 4/88/Seite 83
  927. SUB Farbwahl STATIC
  928.   SHARED SNr:feldx=WINDOW(2)/10:feldy=WINDOW(3)/4:bahn=feldy/7
  929.   WINDOW 88,,(feldx,feldy)-(9*feldx,3.25*feldy+25),0,SNr
  930.   fx=WINDOW(2):fy=WINDOW(3)
  931.   Farbzahl=WINDOW(6)
  932.   IF dimflag=0 THEN DIM Farbwert!(Farbzahl,3):dimflag=1
  933.   Tabellenanfang&=PEEKL(4+PEEKL(4+(44+PEEKL(WINDOW(7)+46))))
  934.   FOR i=0 TO Farbzahl:Farbwert!(i,0)=PEEKW(Tabellenanfang&+2*i):NEXT i
  935. Farbspeicher:
  936.   aktivfarbe=0:COLOR 1,0
  937.   py%=2*(feldy+bahn):px%=2*(feldx-bahn):GOSUB curpos:PRINT "RESET"
  938.   px%=6*feldx-bahn:GOSUB curpos:PRINT "OK"
  939.   py%=2*(feldy+bahn+11):px%=2*(feldx-bahn-7):GOSUB curpos:PRINT "GRUNDWERTE";
  940.   py%=2*(feldy+bahn+11):px%=6*(feldx-bahn):GOSUB curpos:PRINT "ABBRUCH";
  941.   FOR i=0 TO Farbzahl:hd!=Farbwert!(i,0)
  942.   FOR J=1 TO 3
  943.   hx!=hd!\16^(3-J):hd!=hd!-hx!*16^(3-J)
  944.   Farbwert!(i,J)=INT(hx!*6.667)/100
  945.   NEXT J
  946.   PALETTE i,Farbwert!(i,1),Farbwert!(i,2),Farbwert!(i,3)
  947.   LINE(i*8*feldx/(Farbzahl+1),feldy)-((i+1)*8*feldx/(Farbzahl+1),2*feldy),i,bf
  948.   NEXT i
  949.   LINE(0,0)-(8*feldx,2.5*feldy),1,b
  950.   LINE(0,feldy)-(8*feldx,2*feldy),1,b
  951.   LINE(4*feldx,2*feldy)-(4*feldx,2.5*feldy)
  952.   LINE(4*feldx,2*feldy+30)-(4*feldx,2.65*feldy+1)
  953.   GOSUB reglerfeld
  954. mcheck:
  955.   Flag=MOUSE(0)
  956.   IF Flag THEN GOSUB farbfeldwahl
  957.   IF Flag<0 THEN GOSUB regeln
  958.   GOTO mcheck
  959. regeln:
  960.   IF MOUSE(2)>feldy-bahn OR MOUSE(2)<bahn THEN RETURN
  961.   i=(MOUSE(2)-6)\(bahn*2)+1
  962.   posx!=MOUSE(1)
  963.   IF posx!<2*feldx OR posx!>6*feldx THEN RETURN
  964.   py%=bahn*i*2:GOSUB regler1
  965.   RETURN
  966. farbfeldwahl:
  967.   y=MOUSE(4):IF y<feldy OR y>3*feldy THEN RETURN
  968.   x=MOUSE(3):IF x<0 OR x>feldx*8 THEN RETURN
  969.   IF x>feldx/30 AND x<feldx*4 AND y>fy-23 AND y<fy THEN Grundwerte
  970.   IF x>feldx*4 AND x<feldx*8 AND y>fy-23 AND y<fy THEN WINDOW CLOSE 88:EXIT SUB    
  971.   IF y<2*feldy THEN
  972.     aktivfarbe=INT(x/(8*feldx/(Farbzahl+1)))
  973.     GOSUB reglerfeld:RETURN
  974.   END IF
  975. IF x<4*feldx THEN Farbspeicher
  976. 'Farbwerte auf Diskette speichern
  977.   WINDOW CLOSE 88:MOUSE ON
  978.   OPEN "Farbdaten" FOR OUTPUT AS 1
  979.   PRINT#1,Farbzahl
  980.   FOR i=0 TO Farbzahl:FOR J=1 TO 3:PRINT#1,Farbwert!(i,J):NEXT J,i
  981.   CLOSE 1
  982.   EXIT SUB
  983. RETURN
  984. Grundwerte:  
  985.   RESTORE Grunddaten
  986.   READ Farbzahl
  987.   FOR i=0 TO Farbzahl
  988.     FOR J=1 TO 3
  989.       READ Farbwert!(i,J)
  990.     NEXT J
  991.     PALETTE i,Farbwert!(i,1),Farbwert!(i,2),Farbwert!(i,3)
  992.   NEXT i
  993. RETURN
  994. reglerfeld:
  995.   LINE (0,0)-(8*feldx,feldy),aktivfarbe,bf
  996.   LINE (0,0)-(8*feldx,feldy),1,b
  997.   zfarbe=Farbzahl-aktivfarbe
  998.   COLOR zfarbe,aktivfarbe
  999.   RESTORE reglerfeld: DATA ROT,GR<0x5c>N,BLAU
  1000.   px%=feldx-bahn
  1001.   FOR i=1 TO 3
  1002.     py%=bahn*i*2:GOSUB curpos:READ m$:PRINT m$
  1003.     posx!=Farbwert!(aktivfarbe,i)*feldx*4+2*feldx
  1004.     GOSUB regler2
  1005.     LINE (feldx*2-1,py%+2)-(feldx*6+1,py%-bahn-2),zfarbe,b
  1006.   NEXT
  1007. RETURN
  1008. regler1:
  1009.   Farbwert!(aktivfarbe,i)=INT((posx!-feldx*2)/feldx*25)/100
  1010.   PALETTE aktivfarbe,Farbwert!(aktivfarbe,1),Farbwert!(aktivfarbe,2),Farbwert!(aktivfarbe,3)
  1011. regler2:
  1012.   LINE (posx!,py%)-(feldx*6,py%-bahn),aktivfarbe,bf
  1013.   LINE (feldx*2,py%)-(posx!,py%-bahn),zfarbe,bf
  1014.   px%=feldx*6+bahn:GOSUB curpos
  1015.   PRINT Farbwert!(aktivfarbe,i);" "
  1016.   px%=feldx-bahn
  1017. RETURN
  1018. curpos:
  1019.   POKEW WINDOW(8)+36,px%:POKEW WINDOW(8)+38,py%:RETURN
  1020. Grunddaten:
  1021. DATA 3,0,0,0,.66,.66,.66,0,.54,0,1,.53,0
  1022. END SUB
  1023. SUB dos.lib STATIC
  1024.  OPEN "ram:dos.bmap" FOR OUTPUT AS 1
  1025.  PRINT#1,"Lock";CHR$(0);CHR$(255);CHR$(172);CHR$(2);CHR$(3);CHR$(0);
  1026.  PRINT#1,"UnLock";CHR$(0);CHR$(255);CHR$(166);CHR$(2);CHR$(0);
  1027.  PRINT#1,"Examine";CHR$(0);CHR$(255);CHR$(154);CHR$(2);CHR$(3);CHR$(0);
  1028.  PRINT#1,"ExNext";CHR$(0);CHR$(255);CHR$(148);CHR$(2);CHR$(3);CHR$(0);
  1029.  PRINT#1,"IoErr";CHR$(0);CHR$(255);CHR$(124);CHR$(0);
  1030.  PRINT#1,"Execute";CHR$(0);CHR$(255);CHR$(34);CHR$(2);CHR$(3);CHR$(4);CHR$(0);
  1031.  CLOSE 1
  1032.  LIBRARY "RAM:dos.library"
  1033.  KILL "RAM:dos.bmap"
  1034. END SUB
  1035. SUB intuition.lib STATIC
  1036.  OPEN "ram:intuition.bmap" FOR OUTPUT AS 1
  1037.  PRINT#1,"SetWindowTitles";CHR$(0);CHR$(254);CHR$(236);CHR$(9);CHR$(10);CHR$( 11);CHR$(0);
  1038.  PRINT#1,"SizeWindow";CHR$(0);CHR$(254);CHR$(224);CHR$(9);CHR$(1);CHR$(2);CHR$(0);
  1039.  PRINT#1,"WindowToBack";CHR$(0);CHR$(254);CHR$(206);CHR$(9);CHR$(0);
  1040.  PRINT#1,"WindowToFront";CHR$(0);CHR$(254);CHR$(200);CHR$(9);CHR$(0);
  1041.  PRINT#1,"WindowLimits";CHR$(0);CHR$(254);CHR$(194);CHR$(9);CHR$(1);CHR$(2);CHR$( 3);CHR$(4);CHR$(0);
  1042.  PRINT#1,"AllocRemember";CHR$(0);CHR$(254);CHR$(116);CHR$(9);CHR$(1);CHR$(2);CHR$(0);
  1043.  PRINT#1,"FreeRemember";CHR$(0);CHR$(254);CHR$(104);CHR$(9);CHR$(1);CHR$(0);
  1044.  PRINT#1,"ActivateWindow";CHR$(0);CHR$(254);CHR$(62);CHR$(9);CHR$(0);
  1045.  CLOSE 1
  1046.  LIBRARY "RAM:intuition.library"
  1047.  KILL "RAM:intuition.bmap"
  1048. END SUB
  1049.  
  1050.